Aminet 30/Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso/Aminet/dev/lang/SmallEiffel.lha/SmallEiffel/lib_std/native_array.e

Text File | 1998-12-22 | 11KB | 466 lines

-- This file is  free  software, which  comes  along  with  SmallEiffel. This
-- software  is  distributed  in the hope that it will be useful, but WITHOUT
-- ANY  WARRANTY;  without  even  the  implied warranty of MERCHANTABILITY or
-- FITNESS  FOR A PARTICULAR PURPOSE. You can modify it as you want, provided
-- this header is kept unaltered, and a notification of the changes is added.
-- You  are  allowed  to  redistribute  it and sell it, alone or as a part of
-- another product.
--          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
--            Dominique COLNET and Suzanne COLLIN - [e-mail]
--                       http://www.loria.fr/SmallEiffel
--
expanded class NATIVE_ARRAY[E]
--
-- This class gives access to the lowest level for arrays both
-- for the C language and Java language.
--
-- Warning : using this class makes your Eiffel code non
-- portable on other Eiffel systems.
-- This class may also be modified in further release for a better
-- interoperability between Java and C low level arrays.
--

feature -- Basic features :

   element_sizeof: INTEGER is
     -- The size in number of bytes for type `E'.
      external "SmallEiffel"
      end;

   calloc(nb_elements: INTEGER): like Current is
     -- Allocate a new array of `nb_elements' of type `E'.
     -- The new array is initialized with default values.
      external "SmallEiffel"
      end;

   item(index: INTEGER): E is
     -- To read an `item'.
     -- Assume that `calloc' is already done and that `index'
     -- is the range [0 .. nb_elements-1].
      external "SmallEiffel"
      end;

   put(element: E; index: INTEGER) is
     -- To write an item.
     -- Assume that `calloc' is already done and that `index'
     -- is the range [0 .. nb_elements-1].
      external "SmallEiffel"
      end;

feature

   realloc(old_nb_elts, new_nb_elts: INTEGER): like Current is
     -- Assume Current is a valid NATIVE_ARRAY in range
     -- [0 .. `old_nb_elts'-1]. Allocate a bigger new array in
     -- range [0 .. `new_nb_elts'-1].
     -- Old range is copied in the new allocated array.
     -- No initialization done for new items in C.
     -- Initialization is done for Java.
     --
      require
     to_pointer.is_not_void;
     old_nb_elts < new_nb_elts
      do
     Result := calloc(new_nb_elts);
     Result.copy_from(Current,old_nb_elts - 1);
      end;

feature -- Comparison :

   memcmp(other: like Current; capacity: INTEGER): BOOLEAN is
     -- True if all elements in range [0..capacity-1] are
     -- identical using `equal'. Assume Current and `other'
     -- are big enough.
     -- See also `fast_memcmp'.
      require
     capacity > 0 implies other.to_pointer.is_not_void
      local
     i: INTEGER;
      do
     from
        Result := true;
        i := capacity - 1;
     until
        i < 0 or else not Result
     loop
        Result := equal_like(item(i),other.item(i));
        i := i - 1;
     end;
      end;

   fast_memcmp(other: like Current; capacity: INTEGER): BOOLEAN is
     -- Same jobs as `memcmp' but uses infix "=" instead `equal'.
      require
     capacity > 0 implies other.to_pointer.is_not_void
      local
     i: INTEGER;
      do
     from
        Result := true;
        i := capacity - 1;
     until
        i < 0 or else not Result
     loop
        Result := item(i) = other.item(i);
        i := i - 1;
     end;
      end;

feature -- Searching :

   index_of(element: like item; upper: INTEGER): INTEGER is
     -- Give the index of the first occurrence of `element' using
     -- `is_equal' for comparison.
     -- Answer `upper + 1' when `element' is not inside.
      require
     upper >= -1
      do
     from
     until
        Result > upper or else equal_like(element,item(Result))
     loop
        Result := Result + 1;
     end;
      end;

   fast_index_of(element: like item; upper: INTEGER): INTEGER is
     -- Same as `index_of' but use basic `=' for comparison.
      require
     upper >= -1
      do
     from
     until
        Result > upper or else element = item(Result)
     loop
        Result := Result + 1;
     end;
      end;

feature -- Removing :

   remove_first(upper: INTEGER) is
     -- Assume `upper' is a valid index.
     -- Move range [1 .. `upper'] by 1 position left.
      require
     upper >= 0
      local
     i: INTEGER;
      do
     from
     until
        i = upper
     loop
        put(item(i + 1),i);
        i := i + 1;
     end;
      end;

   remove(index, upper: INTEGER) is
     -- Assume `upper' is a valid index.
     -- Move range [`index' + 1 .. `upper'] by 1 position left.
      require
     index >= 0;
     index <= upper
      local
     i: INTEGER;
      do
     from
        i := index;
     until
        i = upper
     loop
        put(item(i + 1),i);
        i := i + 1;
     end;
      end;

feature -- Replacing :

   replace_all(old_value, new_value: like item; upper: INTEGER) is
           -- Replace all occurences of the element `old_value' by `new_value'
     -- using `is_equal' for comparison.
     -- See also `fast_replace_all' to choose the apropriate one.
      require
     upper >= -1
      local
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        if equal_like(old_value,item(i)) then
           put(new_value,i);
        end;
        i := i - 1;
     end;
      end;


   fast_replace_all(old_value, new_value: like item; upper: INTEGER) is
           -- Replace all occurences of the element `old_value' by `new_value'
     -- using basic `=' for comparison.
     -- See also `replace_all' to choose the apropriate one.
      require
     upper >= -1
      local
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        if old_value = item(i) then
           put(new_value,i);
        end;
        i := i - 1;
     end;
      end;

feature -- Adding :

   copy_at(start_index: INTEGER; model: like Current; model_capacity: INTEGER) is
     -- Copy range [0 .. model_capacity-1] of `model' starting to
     -- write at `start_index' of Current.
     -- Range [start_index .. start_index+model_capacity] of
     -- Current is affected (assume Current is large enough).
      require
     start_index >= 0;
     model_capacity >= 0;
     model_capacity > 0 implies model.to_pointer.is_not_void
      local
     i1, i2: INTEGER;
      do
     from
        i1 := start_index;
     until
        i2 = model_capacity
     loop
        put(model.item(i2),i1);
        i2 := i2 + 1;
        i1 := i1 + 1;
     end;
      end;

feature -- Other :

   set_all_with(v: like item; upper: INTEGER) is
     -- Set all elements in range [0 .. upper] with
     -- value `v'.
      local
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        put(v,i);
        i := i - 1;
     end;
      end;

   clear_all(upper: INTEGER) is
     -- Set all elements in range [0 .. `upper'] with
     -- the default value.
      local
     v: E;
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        put(v,i);
        i := i - 1;
     end;
      end;

   clear(lower, upper: INTEGER) is
     -- Set all elements in range [`lower' .. `upper'] with
     -- the default value
      require
         lower >= 0;
         upper >= lower
      local
         v: E;
         i: INTEGER;
      do
         from
            i := lower
         until
            i > upper
         loop
            put(v, i);
            i := i + 1;
         end
      end

   copy_from(model: like Current; upper: INTEGER) is
     -- Assume `upper' is a valid index both in Current
     -- and `model'.
      local
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        put(model.item(i),i);
        i := i - 1;
     end;
      end;

   move(lower, upper, offset: INTEGER) is
     -- Move range [`lower' .. `upper'] by `offset' positions.
     -- Freed positions are not initialized to default values.
      require
         lower >= 0;
         upper >= lower;
         lower + offset >= 0
      local
         i: INTEGER;
      do
         if offset = 0 then
         elseif offset < 0 then
            from
               i := lower;
            until
               i > upper
            loop
               put(item(i), i + offset);
               i := i + 1;
            end
         else
            from
               i := upper;
            until
               i < lower
            loop
               put(item(i), i + offset);
               i := i - 1;
            end
         end
      end

   nb_occurrences(element: like item; upper: INTEGER): INTEGER is
     -- Number of occurrences of `element' in range [0..upper]
     -- using `equal' for comparison.
     -- See also `fast_nb_occurrences' to chose the apropriate one.
      local
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        if equal_like(element,item(i)) then
           Result := Result + 1;
        end;
        i := i - 1;
     end;
      end;

   fast_nb_occurrences(element: like item; upper: INTEGER): INTEGER is
     -- Number of occurrences of `element' in range [0..upper]
     -- using basic "=" for comparison.
     -- See also `fast_nb_occurrences' to chose the apropriate one.
      local
     i: INTEGER;
      do
     from
        i := upper;
     until
        i < 0
     loop
        if element = item(i) then
           Result := Result + 1;
        end;
        i := i - 1;
     end;
      end;

   all_cleared(upper: INTEGER): BOOLEAN is
     -- Are all items in range [0..upper] set to default
     -- values?
      require
     upper >= -1
      local
     i: INTEGER;
     model: like item;
      do
     from
        Result := true;
        i := upper;
     until
        i < 0 or else not Result
     loop
        Result := model = item(i)
        i := i - 1;
     end;
      end;

feature -- The Guru section :

   free is
     -- Do nothing when producing Java byte code.
     -- Do what's to be done when producing C code (depends
     -- on GC is on or off).
      obsolete "Replaced by automatic Garbage Collection. %
             %Will be removed in the next release."
      do
      end;

feature -- Interfacing with C :

   to_external: POINTER is
     -- Gives access to the C pointer on the area of storage.
      do
     Result := to_pointer;
      end;

   from_pointer(pointer: POINTER): like Current is
     -- Convert `pointer' into Current type.
      external "SmallEiffel"
      end;

   is_not_void: BOOLEAN is
      do
     Result := to_pointer.is_not_void;
      end;

feature -- For C only :

   bytes_malloc(nb_bytes: INTEGER): like Current is
      obsolete "Will be removed in the next release."
      external "C_InlineWithoutCurrent"
      alias "malloc"
      end;

feature {NONE}

   frozen equal_like(e1, e2: like item): BOOLEAN is
     -- Note: this feature is called to avoid calling `equal'
     -- on expanded types (no automatic conversion to
     -- corresponding reference type).
      do
     if e1.is_basic_expanded_type then
        Result := e1 = e2;
     elseif e1.is_expanded_type then
        Result := e1.is_equal(e2);
     elseif e1 = e2 then
        Result := true;
     elseif e1 = Void or else e2 = Void then
     else
        Result := e1.is_equal(e2);
     end;
      end;

end -- NATIVE_ARRAY[E]